home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #06 (Feb 86) / pascal 2.2 / Random Walk.Sound_to_Clip < prev    next >
Text File  |  1985-12-20  |  2KB  |  79 lines
  1. program FFWave_to_Clip;
  2.  uses
  3.   sane;
  4.  const
  5.   WTSize = 22200;{ 370*60=one second of sound }
  6.  
  7.  type
  8.   ptr = ^integer;
  9.   Handle = ^ptr;
  10.  
  11.   MySynthH = ^MySynthP;
  12.   MySynthP = ^MySynthRec;
  13.  
  14.   mySynthRec = record
  15.     mode : integer;
  16.     rate : fixed;
  17.     WaveBytes : packed array[0..22199] of char;{ WTSize bytes }
  18.    end;
  19.  
  20.  var
  21.   waveH : MySynthH;
  22.   n, i, ticks, retraces : integer;
  23.  
  24.  
  25.  procedure Wave_to_Clip (waveH : MySynthH;
  26.          name : str255);
  27.   var
  28.    TheType, llength, lll : longint;
  29.    str : str255;
  30. { The Hlock that is predefined does not work!!! }
  31.   procedure Hlock (H : Handle);
  32.    var
  33.     regs : array[0..12] of longint;
  34.   begin
  35.    regs[0] := ord(h);{ set A0 }
  36.    Generic($A029, regs);
  37.   end;
  38.  begin
  39.   lll := LinlineF($A9FC);{ ZeroScrap }
  40.   str := 'WAVE';
  41.   BlockMove(@str[1], @TheType, 4);{ TheType:='WAVE' }
  42.   llength := GetHandleSize(waveH);
  43.   Hlock(pointer(ord(waveH)));
  44.   lll := LinlineF($A9FE, llength, theType, waveH^);{ PutScrap}
  45.   Hunlock(pointer(ord(waveH)));
  46.  
  47.   llength := Length(name);
  48.   str := 'TEXT';
  49.   BlockMove(@str[1], @TheType, 4);{ TheType:='TEXT' }
  50.   lll := LinlineF($A9FE, llength, theType, @name[1]);{ PutScrap}
  51.  end;
  52.  
  53.  
  54. begin
  55.  waveH := NewHandle(WTSize + 6);{ size of mySynthRec }
  56.  waveH^^.mode := FFMode;
  57.  waveH^^.rate := FixRatio(1, 1);
  58.  
  59.  ShowDrawing;
  60.  textmode(srcCopy);
  61.  n := 128;
  62.  for ticks := 0 to 59 do{ 60 ticks }
  63.   begin
  64.    moveto(0, 256 - n);
  65.    for retraces := 0 to 369 do{ 370 retraces }
  66.     begin
  67.      i := retraces + ticks * 370;
  68.      repeat
  69.       n := n - (random div 8192);
  70.      until (n >= 0) and (n <= 255);
  71.  
  72.      waveH^^.WaveBytes[i] := chr(n);
  73.      lineto(retraces, 256 - n);
  74.     end;{ of retraces loop }
  75.    DrawString(Stringof(ticks));
  76.   end;{ of ticks loop }
  77.  Wave_to_Clip(waveH, 'Random walk Waveform');
  78.  DisposeHandle(waveH);
  79. end.